perm filename EUCLID[G,BGB] blob
sn#087674 filedate 1974-02-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00017 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE EUCLID - EUCLIDEAN TRANSFORMATIONS - JULY 1972.
C00004 00003 SUBR(MKROT1,PAN,TILT,SWING)
C00006 00004 SUBR(MKFFRM,FACE) MAKE FACE FRAME.
C00008 00005 SUBR(TRANSLATE,FRMOBJ,DX,DY,DZ) OBJECT TRANSLATION WRT FRAME.
C00010 00006 SUBR(ROTATE,FRMOBJ,ABOUTX,ABOUTY,ABOUTZ) OBJECT ROTATION WRT FRAME.
C00013 00007 SUBR(NORM,FRAME) NORMALIZE A FRAME MATRIX.
C00015 00008 SUBR(ORTHO1,FRAME) ORTHOGONIZE AN ORIENTATION MATRIX.
C00018 00009 SUBR(ORTHO2,FRAME)
C00020 00010 SUBR(DETERM,FRAME)
C00021 00011 SUBR(ANGL3V,VERT1,VERT2,VERT3) ANGLE TRI-VERTEX.
C00024 00012 SUBR(DISTAN,V1,V2) DISTANCE BETWEEN TWO VERTICES.
C00025 00013 SUBR(ROTOR)
C00027 00014 SUBR(APTRAN,OBJECT,TRAN) APPLY EUCLIDEAN TRANSFORMATION TO THE OBJECT.
C00029 00015 ----(APTRAN) BODY ROTATION.
C00030 00016 ----(APTRAN) FACE ROTATION.
C00032 00017 SUBR(INTRAN,TRAN) INVERT A TRANSFORMATION.
C00034 ENDMK
C⊗;
TITLE EUCLID - EUCLIDEAN TRANSFORMATIONS - JULY 1972.
EXTERN ECW,ECCW,OTHER
EXTERN BGET,FCW,FCCW,VCW,VCCW
EXTERN MKCOPY,MKFRAME,KLNODE
EXTERN SIN,COS,SQRT,ATAN,ATAN2,ASIN,ACOS,LOG,HALFPI,PI,TWOPI
COMMENT /------------------------------------------------------------
FRAME ← TRANSLATE(REFRAM+OBJECT,DX,DY,DZ);
FRAME ← ROTATE(REFRAM+OBJECT,ABOUTX,ABOUTY,ABOUTZ);
FRAME ← SHRINK(REFRAM+OBJECT,KX,KY,KZ);
NORM(FRAME);
ORTHO1(FRAME);
DISTANCE(V1,V2);
ROTOR; V,Q.
APTRAN(CBFEV,ETRAN);
INTRAN(TRAN);
/
SUBR(MKROT1,PAN,TILT,SWING)
;--------------------------------------------------------------------
SETQ(CP,{COS,PAN})↔ SETQ(SP,{SIN,PAN})
SETQ(CT,{COS,TILT})↔ SETQ(ST,{SIN,TILT})
SETQ(CS,{COS,SWING})↔ SETQ(SS,{SIN,SWING})
CALL(MKFRAME)
LAC SP↔FMP CT↔FMP SS↔DAC 2↔LAC CP↔FMP CS↔FSB 2↔DAC IX(1)
LAC CP↔FMP CT↔FMP SS↔DAC 2↔LAC SP↔FMP CS↔FAD 2↔DAC IY(1)
LAC ST↔FMP SS↔DAC IZ(1)
LAC SP↔FMP CT↔FMP CS↔DAC 2↔LAC CP↔FMP SS↔FAD 2↔MOVNM JX(1)
LAC CP↔FMP CT↔FMP CS↔DAC 2↔MOVN SP↔FMP SS↔FAD 2↔DAC JY(1)
LAC ST↔FMP CS↔DAC JZ(1)
LAC SP↔FMP ST↔DAC KX(1)
LAC CP↔FMP ST↔MOVNM KY(1)
LAC CT↔DAC KZ(1)↔POP3J
DECLARE{CP,CT,CS,SP,ST,SS}
ENDR MKROT1;10/30/73(BGB)--------------------------------------------
SUBR(MKFFRM,FACE) ;MAKE FACE FRAME.
;--------------------------------------------------------------------
ACCUMULATORS{F,E,E0,V,X,Y,Z,N}
LAC F,FACE
PED E,F↔DAC E,E0
SETZB X,Y↔SETZB Z,N
L1: SETQ(V,{VCCW,E,F})↔SETQ(E,{ECCW,E,F})
FADR X,XWC(V)↔FADR Y,YWC(V)↔FADR Z,ZWC(V)
CAME E,E0↔AOJA N,L1↔AOS N
;CENTER OF FACE BECOMES ORIGIN.
FLOAT N,↔FDVR X,N↔FDVR Y,N↔FDVR Z,N
SETQ(F,{MKFRAME})↔DAC F,FRM#
DAC X,XWC(F)↔DAC Y,YWC(F)↔DAC Z,ZWC(F)
;FIRST TWO VECTORS.
SETQ(V,{VCW,E0,FACE})
LAC XWC(V)↔FSBR X↔DAC IX(F)
LAC YWC(V)↔FSBR Y↔DAC IY(F)
LAC ZWC(V)↔FSBR Z↔DAC IZ(F)
SETQ(V,{VCCW,E0,FACE})
LAC XWC(V)↔FSBR X↔DAC JX(F)
LAC YWC(V)↔FSBR Y↔DAC JY(F)
LAC ZWC(V)↔FSBR Z↔DAC JZ(F)
CALL(ORTHO2,FRM)
CALL(NORM,FRM)
CALL(ORTHO1,FRM)
LAC 1,FRM↔POP1J
ENDR MKFFRM;2/19/74(BGB)---------------------------------------------
SUBR(TRANSLATE,FRMOBJ,DX,DY,DZ) ;OBJECT TRANSLATION WRT FRAME.
COMMENT ⊗------------------------------------------------------------
⊗↔ CALL(MKFRAME)
LAC DX↔DAC XWC(1)
LAC DY↔DAC YWC(1)
LAC DZ↔DAC ZWC(1)
↑QTRAN: DAC 1,TMP1
MOVM 2,FRMOBJ↔CDR 2,2↔DAC 2,OBJECT
HLRE 1,FRMOBJ↔SKIPGE 1↔GO[
SETZ 1,↔JUMPE 2,.+1 ;JUMP WHEN NO OBJECT.
CALL(BGET,OBJECT) ;GET BODY OF THE OBJECT.
FRAME 1,1↔GO .+1] ;GET FRAME OF THE BODY.
DAC 1,REFRAM ;FRAME OF REFERENCE.
LAC 1,TMP1↔SKIPN REFRAM↔GO L1
L0: SETQ(TMP2,{MKCOPY,REFRAM})
CALL(INTRAN,TMP2)
CALL(APTRAN,TMP2,TMP1)
CALL(APTRAN,TMP2,REFRAM)
CALL(KLNODE,TMP1)
LAC 1,TMP2↔DAC 1,TMP1
L1: SKIPN OBJECT↔POP4J ;RETURN TRANSFORMATION.
CALL(APTRAN,OBJECT,TMP1)
CALL(KLNODE,TMP1)
LAC 1,OBJECT↔POP4J ;RETURN OBJECT.
DECLARE{TMP1,TMP2,REFRAM,OBJECT}
ENDR TRANSLATE;3/18/73(BGB)------------------------------------------
SUBR(ROTATE,FRMOBJ,ABOUTX,ABOUTY,ABOUTZ) ;OBJECT ROTATION WRT FRAME.
COMMENT ⊗------------------------------------------------------------
⊗
L1: SETZM TMP1↔SKIPN ABOUTX↔GO L2↔SETQ(TMP1,{MKFRAME})
CALL(COS,ABOUTX)↔LAC 2,TMP1↔DAC 1,JY(2)↔DAC 1,KZ(2)
CALL(SIN,ABOUTX)↔LAC 2,TMP1↔DAC 1,JZ(2)↔MOVNM 1,KY(2)
L2: SETZM TMP2↔SKIPN ABOUTY↔GO L3↔SETQ(TMP2,{MKFRAME})
CALL(COS,ABOUTY)↔LAC 2,TMP2↔DAC 1,IX(2)↔DAC 1,KZ(2)
CALL(SIN,ABOUTY)↔LAC 2,TMP2↔DAC 1,KX(2)↔MOVNM 1,IZ(2)
L3: SETZM TMP3↔SKIPN ABOUTZ↔GO L4↔SETQ(TMP3,{MKFRAME})
CALL(COS,ABOUTZ)↔LAC 2,TMP3↔DAC 1,IX(2)↔DAC 1,JY(2)
CALL(SIN,ABOUTZ)↔LAC 2,TMP3↔DAC 1,IY(2)↔MOVNM 1,JX(2)
L4: SKIPN 1,TMP2↔GO L5 ;TMP1 ← TMP1 * TMP2.
SKIPN TMP1↔GO[DAC 1,TMP1↔GO L5]
CALL(APTRAN,TMP1,TMP2)
CALL(KLNODE,TMP2)
L5: SKIPN 1,TMP3↔GO L6 ;TMP1 ← TMP1 * TMP3.
SKIPN TMP1↔GO[DAC 1,TMP1↔GO L6]
CALL(APTRAN,TMP1,TMP3)
CALL(KLNODE,TMP3)
L6: SKIPN 1,TMP1↔CALL(MKFRAME) ;IDENTITY.
JCALL QTRAN
DECLARE{TMP1,TMP2,TMP3,REFRAM,OBJECT}
ENDR ROTATE;3/18/73(BGB)---------------------------------------------
SUBR(SHRINK,FRMOBJ,KKX,KKY,KKZ) ;DILATION-REFLECTION WRT FRAME.
COMMENT ⊗------------------------------------------------------------
⊗↔ CALL(MKFRAME)
SKIPN 2,KKX↔MOVSI 2,(1.0)↔DAC 2,IX(1)
SKIPN 2,KKY↔MOVSI 2,(1.0)↔DAC 2,JY(1)
SKIPN 2,KKZ↔MOVSI 2,(1.0)↔DAC 2,KZ(1)
JCALL QTRAN
ENDR SHRINK;3/18/73(BGB)---------------------------------------------
SUBR(NORM,FRAME) ; NORMALIZE A FRAME MATRIX.
COMMENT ⊗------------------------------------------------------------
ACCUMULATORS:
05 06 07 IX IY IZ
10 11 12 JX JY JZ
13 14 15 KX KY KZ
⊗↔ SAVAC(15)
MOVS FRAME↔HRRI 5↔BLT 15
; R ← SQRT(A↑2+B↑2+C↑2); A←A/R; B←B/R; C←C/R;
FOR Q IN (5,10,13){
MOVM 1,Q↔CAMG 1,[1.0E-8]↔SETZB 1,Q↔FMPR 1,1
MOVM 1+Q↔CAMG 0,[1.0E-8]↔SETZB 1+Q↔FMPR↔FADR 1,0
MOVM 2+Q↔CAMG 0,[1.0E-8]↔SETZB 2+Q↔FMPR↔FADR 1,0
SKIPE 1↔CAMN 1,[1.0]↔GO .+6↔CALL(SQRT,1)
FDVR Q,1↔FDVR Q+1,1↔FDVR Q+2,1}
;PUT'EM DOWN.
LAC 1,FRAME
MOVSI 5↔HRRI IX(1)↔BLT KZ(1)
GETAC(15)↔POP1J↔VAR
ENDR NORM;1/14/73----------------------------------------------------
SUBR(ORTHO1,FRAME) ; ORTHOGONIZE AN ORIENTATION MATRIX.
COMMENT ⊗------------------------------------------------------------
It is assummed that the row vectors are unit vectors.
⊗
X←←0 ↔ Y←←1 ↔ Z←←2 ;ADDRESS DISPLACEMENTS.
Q←←9 ↔ R←←13 ↔ A←←14 ↔ B←←15 ;ACCUMULATORS.
SAVAC(15)
SETOM FLG# ;FIRST TIME THRU FLAG.
L0: LAC R,FRAME
MOVSI Q,IX(R)↔BLT Q,KZ ;FIRST NINE ACCUMULATORS.
;DOT EACH ROW VECTOR INTO THE NEXT ROW.
FMPR IX,JX↔FMPR IY,JY↔FMPR IZ,JZ
FADR IX,IY↔FADR IX,IZ
FMPR JX,KX↔FMPR JY,KY↔FMPR JZ,KZ
FADR JX,JY↔FADR JX,JZ
FMPR KX,IX(R)↔FMPR KY,IY(R)↔FMPR KZ,IZ(R)
FADR KX,KY↔FADR KX,KZ
;TAKE ABSOLUTE VALUES AND FIND THE WORST TOTAL COSINE.
MOVMS IX↔MOVMS JX↔MOVMS KX
LAC Q,KX↔FADR KX,JX↔FADR JX,IX↔FADR Q,IX
EXCH Q,JX↔SETZM SIGN#
MOVEI 1,IX(R)↔MOVEI 2,JX(R)↔MOVEI 3,KX(R) ;GET ROW POINTERS.
CAML Q,IX↔GO .+4
EXCH 2,1↔EXCH Q,IX↔SETCMM SIGN ;GET 2 BIGGER THAN 1.
CAML KX,Q↔GO .+4
EXCH 3,2↔EXCH KX,Q↔SETCMM SIGN ;GET 3 BIGGER THAN 2.
CAMG KX,[0.00001]↔GO L1 ;GOOD ENUF FOR GOVERNMENT WORK.
;STRAIGHTEN UP THE WORST VECTOR.
LAC A,Y(1)↔FMPR A,Z(2)
LAC B,Y(2)↔FMPR B,Z(1)↔FSBR A,B↔DAC A,X(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM X(3)
LAC A,X(2)↔FMPR A,Z(1)
LAC B,X(1)↔FMPR B,Z(2)↔FSBR A,B↔DAC A,Y(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM Y(3)
LAC A,X(1)↔FMPR A,Y(2)
LAC B,X(2)↔FMPR B,Y(1)↔FSBR A,B↔DAC A,Z(3)
MOVM A,A↔CAMG A,[1.0E-8]↔SETZM Z(3)
SKIPE SIGN↔GO[MOVNS X(3)↔MOVNS Y(3)↔MOVNS Z(3)↔GO .+1]
SKIPN FLG↔GO L1↔SETZM FLG↔GO L0
L1: GETAC(15)↔POP1J↔LIT
ENDR ORTHO1;1/14/73(BGB)---------------------------------------------
SUBR(ORTHO2,FRAME)
COMMENT ⊗------------------------------------------------------------
; ACCEPT I; K' ← I CROSS J; J' ← K CROSS I;
⊗↔ LAC 1,FRAME
SETZM KX(1)↔SETZM KY(1)↔SETZM KZ(1)
CALL(NORM,1)
MOVS FRAME↔HRRI 1↔BLT 9
LAC 12,4↔LAC 13,5↔LAC 14,6 ;SAVE J VECTOR.
;VECTOR-K ← VECTOR-I CROSS VECTOR-J.
LAC 2↔FMP 6↔DAC 7
LAC 5↔FMP 3↔FSB 7,
LAC 4↔FMP 3↔DAC 8
LAC 1↔FMP 6↔FSB 8,
LAC 1↔FMP 5↔DAC 9
LAC 4↔FMP 2↔FSB 9,
;VECTOR-J ← VECTOR-K CROSS VECTOR-I.
LAC 8↔FMP 3↔DAC 4
LAC 2↔FMP 9↔FSB 4,
LAC 1↔FMP 9↔DAC 5
LAC 7↔FMP 3↔FSB 5,
LAC 7↔FMP 2↔DAC 6
LAC 1↔FMP 8↔FSB 6,
LAC 15,FRAME↔MOVSI 1
HRRI IX(15)↔BLT KZ(15)
LAC 1,FRAME↔POP1J
ENDR ORTHO2;3/30/73(BGB)---------------------------------------------
SUBR(DETERM,FRAME)
COMMENT ⊗------------------------------------------------------------
⊗↔ MOVS FRAME↔HRRI 1↔BLT 9
LAC 5↔FMP 9↔LAC 12,
LAC 6↔FMP 8↔FSB 12,↔FMP 1,12
LAC 6↔FMP 7↔LAC 12,
LAC 4↔FMP 9↔FSB 12,↔FMP 2,12↔FAD 1,2
LAC 4↔FMP 8↔LAC 12,
LAC 5↔FMP 7↔FSB 12,↔FMP 3,12↔FAD 1,3↔POP1J
ENDR DETERM;4/1/73(BGB)----------------------------------------------
SUBR(ANGL3V,VERT1,VERT2,VERT3) ;ANGLE TRI-VERTEX.
COMMENT ⊗------------------------------------------------------------
ANGLE V1,V2,V3 CCW; RETURNS VALUE 0 TO 2π.
⊗↔ v1 ←← 13
v2 ←← 14
v3 ←← 15
;DETERMINE WHETHER THE ANGLE IS MORE OR LESS THAN PI.
LAC V1,ARG3↔MOVSI XWC(V1)↔HRRI 1↔BLT 3
LAC V2,ARG2↔MOVSI XWC(V2)↔HRRI 4↔BLT 6
LAC V3,ARG1↔MOVSI XWC(V3)↔HRRI 7↔BLT 9
FSBR 1,4↔FSBR 2,5↔FSBR 3,6 ;V1' ← (V1-V2).
FSBR 7,4↔FSBR 8,5↔FSBR 9,6 ;V3' ← (V3-V2).
LAC 2↔FMP 9↔LAC 4,↔LAC 3↔FMP 8↔FSB 4, ;V2' ← (V1 X V3).
LAC 3↔FMP 7↔LAC 5,↔LAC 1↔FMP 9↔FSB 5,
LAC 1↔FMP 8↔LAC 6,↔LAC 2↔FMP 7↔FSB 6,
FADR 1,4↔FADR 2,5↔FADR 3,6 ;V1" ← (V1'+V2').
FADR 7,4↔FADR 8,5↔FADR 9,6 ;V3" ← (V3'+V2').
;determ negative indicates ccw order, 0 to π.
;determ positive indicates cw order, π to 2π.
CALL({DETERM+3},0)
SKIPL 1↔SKIPA 1,PI↔SETZ 1,↔PUSH P,1
;COSINE LAW.
CALL(DISTANCE,V2,V1)↔PUSH P,1
CALL(DISTANCE,V2,V3)↔PUSH P,1
CALL(DISTANCE,V1,V3)
FMPR 1,1↔MOVNS 1
POP P,2↔LAC 2↔FMPR 2,2
POP P,3↔FMP 3↔FMPR 3,3
FSC 1↔FADR 1,2↔FADR 1,3
FDVR 1,0↔CALL(ACOS,1)
POP P,0↔FADR 1,0↔POP3J
ENDR ANGL3V;4/1/73(BGB)----------------------------------------------
SUBR(ATEST,FACE)
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{F,E,V1,V2,V3}
LAC F,FACE↔PED E,F
SETQ(V1,{VCW,E,F})
SETQ(V2,{VCCW,E,F})
SETQ(E,{ECCW,E,F})
SETQ(V3,{VCCW,E,F})
CALL(ANGL3V,V1,V2,V3)
FMP 1,[180.0]↔FDVR 1,PI
POP1J
ENDR ATEST;----------------------------------------------------------
SUBR(DISTAN,V1,V2) ;DISTANCE BETWEEN TWO VERTICES.
COMMENT ⊗------------------------------------------------------------
⊗↔ LAC 1,V1↔LAC 2,V2
LAC XWC(1)↔FSBR XWC(2)↔FMPR↔DAC 3
LAC YWC(1)↔FSBR YWC(2)↔FMPR↔FADRM 3
LAC ZWC(1)↔FSBR ZWC(2)↔FMPR↔FADR 3
CALL(SQRT,0)↔POP2J
ENDR DISTAN;2/10/73(BGB)---------------------------------------------
SUBR(ROTOR)
COMMENT ⊗------------------------------------------------------------
; APTRAN's inner most subroutine.
; Expects arguments in V and Q. Clobbers 1,2,X,Y,Z.
;
; X ← XWC(V);
; Y ← YWC(V);
; Z ← ZWC(V);
;
; XWC(V) ← X*IX(Q) + Y*JX(Q) + Z*KX(Q) + XWC(Q);
; YWC(V) ← X*IY(Q) + Y*JY(Q) + Z*KZ(Q) + YWC(Q);
; ZWC(V) ← X*IZ(Q) + Y*JZ(Q) + Z*KZ(Q) + ZWC(Q);
;
⊗↔ ACCUMULATORS{B,F,E,V,X,Y,Z,Q}
LAC X,XWC(V)↔LAC Y,YWC(V)↔LAC Z,ZWC(V)
LAC 1,IX(Q)↔CAMN 1,[1.0]↔SKIPA 1,X↔FMPR 1,X
SKIPE 2,JX(Q)↔GO[FMPR 2,Y↔FADR 1,2↔GO .+1]
SKIPE 2,KX(Q)↔GO[FMPR 2,Z↔FADR 1,2↔GO .+1]
SKIPE 2,XWC(Q)↔FADR 1,2↔DAC 1,XWC(V)
LAC 1,JY(Q)↔CAMN 1,[1.0]↔SKIPA 1,Y↔FMPR 1,Y
SKIPE 2,IY(Q)↔GO[FMPR 2,X↔FADR 1,2↔GO .+1]
SKIPE 2,KY(Q)↔GO[FMPR 2,Z↔FADR 1,2↔GO .+1]
SKIPE 2,YWC(Q)↔FADR 1,2↔DAC 1,YWC(V)
LAC 1,KZ(Q)↔CAMN 1,[1.0]↔SKIPA 1,Z↔FMPR 1,Z
SKIPE 2,JZ(Q)↔GO[FMPR 2,Y↔FADR 1,2↔GO .+1]
SKIPE 2,IZ(Q)↔GO[FMPR 2,X↔FADR 1,2↔GO .+1]
SKIPE 2,ZWC(Q)↔FADR 1,2↔DAC 1,ZWC(V)
POP0J
ENDR ROTOR;3/18/73(BGB)-------------------------------------------
SUBR(APTRAN,OBJECT,TRAN); APPLY EUCLIDEAN TRANSFORMATION TO THE OBJECT.
COMMENT ⊗------------------------------------------------------------
⊗↔ ACCUMULATORS{B,F,E,V,X,Y,Z,TRN,N,OBJ,E0}
SKIPN TRN,TRAN↔POP2J
;BRANCH ON TYPE OF OBJECT.
LAC OBJ,OBJECT
MOVM 1,(OBJ)↔JUMPE 1,LROTA
TLNE 1,(1B9)↔GO LROTA ;FRAME.
ANDI 1,17
CAIN 1,$BODY↔GO BROTA ;BODY.
CAIN 1,$CAMERA↔GO CROTA ;CAMERA.
CAIN 1,$SUN↔GO CROTA ;SUN-CAMERA.
CAIN 1,$FACE↔GO FROTA ;FACE.
CAIN 1,$EDGE↔GO EROTA ;EDGE.
CAIN 1,$VERT↔GO VROTA ;VERT.
CAIE 1,$YNODE↔POP2J
YCODE 1,OBJ
CAIN 1,$TEXTHD↔GO VROTA ;TEXT HEADER
POP2J
LROTA: LAC V,OBJ↔SETZM TMP2#↔GO .+3 ;FRAME CASE.
CROTA: FRAME V,OBJ↔DAC V,TMP2# ;CAMERA CASE.
CALL(ROTOR)
PUSH P,XWC(TRN)↔PUSH P,YWC(TRN)↔PUSH P,ZWC(TRN)
SETZM XWC(TRN)↔SETZM YWC(TRN)↔SETZM ZWC(TRN)
ADDI V,3↔CALL(ROTOR)
ADDI V,3↔CALL(ROTOR)
ADDI V,3↔CALL(ROTOR)
POP P,ZWC(TRN)↔POP P,YWC(TRN)↔POP P,XWC(TRN)
SKIPN TMP2↔POP2J
CALL(NORM,TMP2#)
CALL(ORTHO1,TMP2#)
POP2J
;----(APTRAN) BODY ROTATION.
BROTA: LAC B,OBJ
TESTZ B,BDVBIT↔GO L2 ;DON'T MOVE VERTICES.
LAC V,B ;1ST VERTEX.
L1: PVT V,V
CAMN V,OBJ↔GO L2 ;SKIP WHEN VERTEX.
CALL(ROTOR)↔GO L1 ;ROTATE VERTEX.
L2: LAC B,OBJ
TESTZ B,BDLBIT↔GO L3 ;DON'T MOVE FRAME.
FRAME V,B↔SKIPN V↔GO L3
DAC V,TMP#↔PUSH P,B
CALL(APTRAN,V,TRN) ;BODY'S FRAME.
CALL(NORM,TMP#)
CALL(ORTHO1,TMP#)
POP P,B
;PARTS OF THIS BODY.
L3: TESTZ B,BDPBIT↔POP2J ;DON'T MOVE PARTS.
SON N,B↔JUMPE N,POP2J.
L4: PUSH P,N
CALL(APTRAN,N,TRN)
POP P,N↔LAC B,OBJECT
BRO N,N↔SON 0,B
CAME 0,N↔GO L4
POP2J
;----(APTRAN) FACE ROTATION.
FROTA: LAC F,OBJ↔NCNT N,F↔MOVMS N
PED E,F↔DAC E,E0↔JUMPE E0,[ ;VERTEX FACE.
PFACE B,F↔PVT V,B↔CALL(ROTOR)↔POP2J]
PCW 0,E↔SKIPN N↔CAMN 0,E↔GO[ ;WIRE OR SHELL FACE.
SETQ(V,{VCW,E,F})↔CALL(ROTOR)↔GO .+1]
L5: SETQ(V,{VCCW,E,F})
CALL(ROTOR)↔CALL(ECCW,E,F)
CAMN 1,E↔POP2J ;END OF WIRE FACE.
LAC E,1↔CAMN E,E0↔POP2J ;END OF NORMAL FACE.
SOJN N,L5↔POP2J ;END OF SHELL FACE.
;EDGE ROTATION.
EROTA: LAC E,OBJ
PVT V,E↔CALL(ROTOR)
NVT V,E↔CALL(ROTOR)
POP2J
;VERTEX ROTATION.
VROTA: LAC V,OBJ
CALL(ROTOR)
POP2J
ENDR APTRAN;1/14/73(BGB)------------------------------------------
SUBR(INTRAN,TRAN) ;INVERT A TRANSFORMATION.
COMMENT ⊗------------------------------------------------------------
⊗↔ Q ←← 6
LAC 2,TRAN
MOVSI XWC(2)↔HRRI XWC+Q↔BLT KZ+Q
;XWC' ← -(XWC*IX + YWC*IY + ZWC*IZ);
LAC 1,XWC+Q↔FMPR 1,IX+Q
LAC YWC+Q↔FMPR IY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR IZ+Q↔FADR 1,0
MOVNM 1,XWC(2)
;YWC' ← -(XWC*JX + YWC*JY + ZWC*JZ);
LAC 1,XWC+Q↔FMPR 1,JX+Q
LAC YWC+Q↔FMPR JY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR JZ+Q↔FADR 1,0
MOVNM 1,YWC(2)
;ZWC' ← -(XWC*KX + YWC*KY + ZWC*KZ);
LAC 1,XWC+Q↔FMPR 1,KX+Q
LAC YWC+Q↔FMPR KY+Q↔FADR 1,0
LAC ZWC+Q↔FMPR KZ+Q↔FADR 1,0
MOVNM 1,ZWC(2)
;TRANSPOSE ROTATION MATRIX.
DAC JX+Q,IY(2)
DAC KX+Q,IZ(2)
DAC IY+Q,JX(2)
DAC KY+Q,JZ(2)
DAC IZ+Q,KX(2)
DAC JZ+Q,KY(2)
LAC 1,2
POP1J
ENDR INTRAN;3/18/73(BGB)---------------------------------------------
END
EUCLID.FAI - EOF.